home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / vol7n12.arc / DATETIME.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-04-28  |  2.7 KB  |  88 lines
  1.  
  2. {$R+,C-}
  3. PROGRAM FileDateAndTime;
  4.  
  5. TYPE
  6.   Str10 = STRING[10];
  7.   Str2 = STRING[2];
  8.   FlagType = (CarryFlag,     NoFlag0002,
  9.               ParityFlag,    NoFlag0008,
  10.               AuxCarryFlag,  NoFlag0020,
  11.               ZeroFlag,      SignFlag,
  12.               StepTrapFlag,  InterruptFlag,
  13.               DirectionFlag, OverflowFlag,
  14.               NoFlag1000,    NoFlag2000,
  15.               NoFlag4000,    NoFlag8000);
  16.   FlagSet = SET OF FlagType;
  17.   RegisterType = RECORD CASE Byte OF
  18.     0 : (AX, BX, CX, DX, BP, SI, DI, DS, ES, FLAGS : Integer);
  19.     1 : (AL, AH, BL, BH, CL, CH, DL, DH : Byte);
  20.     2 : (RegArray : ARRAY[1..9] OF Integer;
  21.          FlagRegister : FlagSet);
  22.                  END;
  23. VAR
  24.   Registers                      : RegisterType;
  25.   FileDate, FileTime, FileYear   : Integer;
  26.   FileMonth, FileDay, FileHour,
  27.   FileMinute, FileSecond         : Byte;
  28.   FileDateString, FileTimeString : Str10;
  29.   AFile                          : FILE;
  30.  
  31.   PROCEDURE InterpretFileDateAndTime(VAR AnyFile; VAR FDate, FTime : Str10);
  32.   CONST GetFileDateAndTime = $5700;
  33.   VAR HandleNumber : Byte ABSOLUTE AnyFile;
  34.     YearString : Str10;
  35.  
  36.     FUNCTION ZeroFill(InByte : Byte) : Str2;
  37.     VAR ZF : Str2;
  38.     BEGIN
  39.       Str(InByte:2, ZF);
  40.       IF ZF[1] = ' ' THEN ZF[1] := '0';
  41.       ZeroFill := ZF;
  42.     END;                      { Function ZeroFill }
  43.  
  44.   BEGIN
  45.     WITH Registers DO
  46.       BEGIN
  47.         AX := GetFileDateAndTime;
  48.         BX := HandleNumber;
  49.         MsDos(Registers);
  50.         IF CarryFlag IN FlagRegister THEN
  51.           BEGIN
  52.             FileDateString := 'Invalid';
  53.             FileTimeString := 'Handle';
  54.           END
  55.         ELSE
  56.           BEGIN
  57.             FileDate := DX;
  58.             FileTime := CX;
  59.             FileYear := ((FileDate AND $FE00) SHR 9)+1980;
  60.             FileMonth := (FileDate AND $01E0) SHR 5;
  61.             FileDay := (FileDate AND $001F);
  62.             FileHour := (FileTime AND $F800) SHR 11;
  63.             FileMinute := (FileTime AND $07E0) SHR 5;
  64.             FileSecond := (FileTime AND $001F);
  65.             Str(FileYear:4, YearString);
  66.             FDate := ZeroFill(FileMonth)+'/'+
  67.             ZeroFill(FileDay)+'/'+
  68.             YearString;
  69.             FTime := ZeroFill(FileHour)+':'+
  70.             ZeroFill(FileMinute)+':'+
  71.             ZeroFill(FileSecond);
  72.           END;
  73.       END;
  74.   END;                        { Procedure InterpretFileDateAndTime }
  75.  
  76. BEGIN
  77.   Assign(AFile, 'FDT.PAS');
  78.   {$I-} Reset(AFile);         {$I+}
  79.   IF IOResult = 0 THEN
  80.     BEGIN
  81.       InterpretFileDateAndTime(AFile, FileDateString, FileTimeString);
  82.       Close(AFile);
  83.       WriteLn(FileDateString, '  ', FileTimeString);
  84.     END
  85.   ELSE
  86.     WriteLn('Where''s FDT.PAS?');
  87. END.
  88.